# loading in SLICER packages
library("devtools")
Loading required package: usethis
install_github("jw156605/SLICER")
Skipping install of 'SLICER' from a github remote, the SHA1 (cb1be8ac) has not changed since last install.
  Use `force = TRUE` to force installation
library(SLICER)
library(lle)
Loading required package: scatterplot3d
Loading required package: MASS

Attaching package: ‘MASS’

The following object is masked from ‘package:plotly’:

    select

The following object is masked from ‘package:AnnotationDbi’:

    select

The following object is masked from ‘package:clusterProfiler’:

    select

The following object is masked from ‘package:dplyr’:

    select

Loading required package: snowfall
Loading required package: snow
# finding the number of initial clusters for reconstructing the trajectory
k = select_k(top_genes, kmin = 3)
finding neighbours
calculating weights
computing coordinates
finding neighbours
calculating weights
computing coordinates
Warning in areaahull(alpha_hull) :
  Problem in area computation (Returns NA)
finding neighbours
calculating weights
computing coordinates
finding neighbours
calculating weights
computing coordinates
finding neighbours
calculating weights
computing coordinates
finding neighbours
calculating weights
computing coordinates
finding neighbours
calculating weights
computing coordinates
finding neighbours
calculating weights
computing coordinates
finding neighbours
calculating weights
computing coordinates
finding neighbours
calculating weights
computing coordinates
# performing LLE a form of dimensionality reduction on the gene expression data
# m = 3 bc that is the number of dimensions used in the figures in the paper 
traj_lle = lle(top_genes, m=3, k)$Y
finding neighbours
calculating weights
computing coordinates
# build a knearest neighbor graph to find the distances betwen cells
traj_graph = conn_knn_graph(traj_lle, k)
# constructing the cell order and finding branches in the trajectory 
ends = find_extreme_cells(traj_graph, traj_lle)

start = 402 # needs to be changed to a known cardiac fibroblast 
cells_ordered = cell_order(traj_graph, start)
graph_process_distance(traj_graph,traj_lle,start)

branches = assign_branches(traj_graph,20, min_branch_len = 10)
Error in if (mean_dist < min_dist) { : 
  missing value where TRUE/FALSE needed
distances_inactive = process_distance(traj_graph, 402) / 5.241427
distances_active = process_distance(traj_graph, 346) / 9.541308
library(rgl)
library(plotly)

active_cells
 [1] "M1_A01" "M1_A05" "M1_B07" "M1_C05" "M1_D01" "M1_D05" "M1_E01" "M1_E03" "M1_E04" "M1_E07" "M1_F04" "M1_H07"
[13] "M1_H08" "M2_B04" "M2_C02" "M2_D04" "M2_E10" "M2_G06" "M2_H08" "C1_B04" "C1_B05" "C1_B09" "C1_C03" "C1_C09"
[25] "C1_C11" "C1_D11" "C1_E01" "C1_F08" "C1_F10" "C1_G02" "C1_G04" "C1_G05" "C1_H05" "M3_A05" "M3_A10" "M3_B07"
[37] "M3_B09" "M3_C01" "M3_C11" "M3_F10" "M4_A01" "M4_A05" "M4_A10" "M4_B06" "M4_C02" "M4_C09" "M4_D02" "M4_D04"
[49] "M4_D06" "M4_E04" "M4_F02" "M4_G04" "M4_H02" "M4_H05" "M5_A07" "M5_A09" "M5_B01" "M5_B08" "M5_C08" "M5_E04"
[61] "M5_E08" "M5_F03" "M5_F04" "M5_H06" "C2_A08" "C2_A10" "C2_A11" "C2_B03" "C2_C07" "C2_C11" "C2_D10" "C2_F08"
[73] "C2_F10" "C2_G03" "C2_G04" "C2_G09" "C2_G10" "C2_G11" "C2_H07" "C2_H08"
top_genes_test = as.data.frame(top_genes)
top_genes_test$row_number = 1:nrow(top_genes_test)
active_cell_numbers = top_genes_test[active_cells,401]

lle_df = data.frame(traj_lle )
lle_df$pseudotime = as.double(t(distances_inactive))
lle_df$active = "CCI"
lle_df[active_cell_numbers,4] = as.double(t(distances_active))[active_cell_numbers]
lle_df[active_cell_numbers,5] = "CCA"
lle_df$active = as.factor(lle_df$active)
lle_df$ident = identified_cells$GroupID_Fig1a
lle_df$ident_2 = cell_categorized$stage

axx <- list(
  title = "LLE 1"
)

axy <- list(
  title = "LLE 2"
)

axz <- list(
  title = "LLE 3"
)

t <- list(
  size = 16,
  color = "black")

fig <- plot_ly(lle_df, x = ~X1, y = ~X2, z = ~X3, marker = list(size = 6), symbol = ~active, symbols = c("diamond", "circle") )
fig <- fig %>% add_markers(color = ~pseudotime, colors = c('black', 'red', 'orange', 'yellow'))
fig <- fig %>% layout(scene = list(aspectmode = "cube", xaxis=axx,yaxis=axy,zaxis=axz), font = t)

fig
 inactive_cell_rows = !(1:nrow(lle_df)  %in% active_cell_numbers )
lle_df[inactive_cell_rows,]
axx <- list(
  title = "LLE 1"
)

axy <- list(
  title = "LLE 2"
)

axz <- list(
  title = "LLE 3"
)

t <- list(
  size = 16,
  color = "black")

fig <- plot_ly(lle_df, x = ~X1, y = ~X2, z = ~X3, color = ~ident_2, marker = list(size = 6), symbol = ~active, symbols = c("diamond", "circle") )
fig <- fig %>% add_markers(colors = c('blue', 'red', 'purple', 'lightgreen'))
fig <- fig %>% layout(scene = list(aspectmode = "cube", xaxis=axx,yaxis=axy,zaxis=axz), font = t)
fig
LS0tCnRpdGxlOiAiUiBOb3RlYm9vayIKb3V0cHV0OiBodG1sX25vdGVib29rCi0tLQoKYGBge3J9CiMgbG9hZGluZyBpbiBTTElDRVIgcGFja2FnZXMKbGlicmFyeSgiZGV2dG9vbHMiKQppbnN0YWxsX2dpdGh1YigiancxNTY2MDUvU0xJQ0VSIikKbGlicmFyeShTTElDRVIpCmxpYnJhcnkobGxlKQpgYGAKCgpgYGB7cn0KIyBmaW5kaW5nIHRoZSBudW1iZXIgb2YgaW5pdGlhbCBjbHVzdGVycyBmb3IgcmVjb25zdHJ1Y3RpbmcgdGhlIHRyYWplY3RvcnkKayA9IHNlbGVjdF9rKHRvcF9nZW5lcywga21pbiA9IDMpCmBgYApgYGB7cn0KIyBwZXJmb3JtaW5nIExMRSBhIGZvcm0gb2YgZGltZW5zaW9uYWxpdHkgcmVkdWN0aW9uIG9uIHRoZSBnZW5lIGV4cHJlc3Npb24gZGF0YQojIG0gPSAzIGJjIHRoYXQgaXMgdGhlIG51bWJlciBvZiBkaW1lbnNpb25zIHVzZWQgaW4gdGhlIGZpZ3VyZXMgaW4gdGhlIHBhcGVyIAp0cmFqX2xsZSA9IGxsZSh0b3BfZ2VuZXMsIG09MywgaykkWQpgYGAKCgpgYGB7cn0KIyBidWlsZCBhIGtuZWFyZXN0IG5laWdoYm9yIGdyYXBoIHRvIGZpbmQgdGhlIGRpc3RhbmNlcyBiZXR3ZW4gY2VsbHMKdHJhal9ncmFwaCA9IGNvbm5fa25uX2dyYXBoKHRyYWpfbGxlLCBrKQpgYGAKYGBge3J9CiMgY29uc3RydWN0aW5nIHRoZSBjZWxsIG9yZGVyIGFuZCBmaW5kaW5nIGJyYW5jaGVzIGluIHRoZSB0cmFqZWN0b3J5IAplbmRzID0gZmluZF9leHRyZW1lX2NlbGxzKHRyYWpfZ3JhcGgsIHRyYWpfbGxlKQpzdGFydCA9IDQwMiAjIG5lZWRzIHRvIGJlIGNoYW5nZWQgdG8gYSBrbm93biBjYXJkaWFjIGZpYnJvYmxhc3QgCmNlbGxzX29yZGVyZWQgPSBjZWxsX29yZGVyKHRyYWpfZ3JhcGgsIHN0YXJ0KQpncmFwaF9wcm9jZXNzX2Rpc3RhbmNlKHRyYWpfZ3JhcGgsdHJhal9sbGUsc3RhcnQpCmJyYW5jaGVzID0gYXNzaWduX2JyYW5jaGVzKHRyYWpfZ3JhcGgsMjAsIG1pbl9icmFuY2hfbGVuID0gMTApCmBgYAoKCmBgYHtyfQpkaXN0YW5jZXNfaW5hY3RpdmUgPSBwcm9jZXNzX2Rpc3RhbmNlKHRyYWpfZ3JhcGgsIDQwMikgLyA1LjI0MTQyNwpkaXN0YW5jZXNfYWN0aXZlID0gcHJvY2Vzc19kaXN0YW5jZSh0cmFqX2dyYXBoLCAzNDYpIC8gOS41NDEzMDgKCmBgYAoKYGBge3J9CmxpYnJhcnkocmdsKQpsaWJyYXJ5KHBsb3RseSkKYGBgCgoKYGBge3J9CgphY3RpdmVfY2VsbHMKdG9wX2dlbmVzX3Rlc3QgPSBhcy5kYXRhLmZyYW1lKHRvcF9nZW5lcykKdG9wX2dlbmVzX3Rlc3Qkcm93X251bWJlciA9IDE6bnJvdyh0b3BfZ2VuZXNfdGVzdCkKYWN0aXZlX2NlbGxfbnVtYmVycyA9IHRvcF9nZW5lc190ZXN0W2FjdGl2ZV9jZWxscyw0MDFdCgpsbGVfZGYgPSBkYXRhLmZyYW1lKHRyYWpfbGxlICkKbGxlX2RmJHBzZXVkb3RpbWUgPSBhcy5kb3VibGUodChkaXN0YW5jZXNfaW5hY3RpdmUpKQpsbGVfZGYkYWN0aXZlID0gIkNDSSIKbGxlX2RmW2FjdGl2ZV9jZWxsX251bWJlcnMsNF0gPSBhcy5kb3VibGUodChkaXN0YW5jZXNfYWN0aXZlKSlbYWN0aXZlX2NlbGxfbnVtYmVyc10KbGxlX2RmW2FjdGl2ZV9jZWxsX251bWJlcnMsNV0gPSAiQ0NBIgpsbGVfZGYkYWN0aXZlID0gYXMuZmFjdG9yKGxsZV9kZiRhY3RpdmUpCmxsZV9kZiRpZGVudCA9IGlkZW50aWZpZWRfY2VsbHMkR3JvdXBJRF9GaWcxYQpsbGVfZGYkaWRlbnRfMiA9IGNlbGxfY2F0ZWdvcml6ZWQkc3RhZ2UKCmBgYAoKCmBgYHtyfQoKYXh4IDwtIGxpc3QoCiAgdGl0bGUgPSAiTExFIDEiCikKCmF4eSA8LSBsaXN0KAogIHRpdGxlID0gIkxMRSAyIgopCgpheHogPC0gbGlzdCgKICB0aXRsZSA9ICJMTEUgMyIKKQoKdCA8LSBsaXN0KAogIHNpemUgPSAxNiwKICBjb2xvciA9ICJibGFjayIpCgpmaWcgPC0gcGxvdF9seShsbGVfZGYsIHggPSB+WDEsIHkgPSB+WDIsIHogPSB+WDMsIG1hcmtlciA9IGxpc3Qoc2l6ZSA9IDYpLCBzeW1ib2wgPSB+YWN0aXZlLCBzeW1ib2xzID0gYygiZGlhbW9uZCIsICJjaXJjbGUiKSApCmZpZyA8LSBmaWcgJT4lIGFkZF9tYXJrZXJzKGNvbG9yID0gfnBzZXVkb3RpbWUsIGNvbG9ycyA9IGMoJ2JsYWNrJywgJ3JlZCcsICdvcmFuZ2UnLCAneWVsbG93JykpCmZpZyA8LSBmaWcgJT4lIGxheW91dChzY2VuZSA9IGxpc3QoYXNwZWN0bW9kZSA9ICJjdWJlIiwgeGF4aXM9YXh4LHlheGlzPWF4eSx6YXhpcz1heHopLCBmb250ID0gdCkKCmZpZwpgYGAKYGBge3J9CmluYWN0aXZlX2NlbGxfcm93cyA9ICEoMTpucm93KGxsZV9kZikgICVpbiUgYWN0aXZlX2NlbGxfbnVtYmVycyApCmxsZV9kZltpbmFjdGl2ZV9jZWxsX3Jvd3MsXQpgYGAKCgoKYGBge3J9CmF4eCA8LSBsaXN0KAogIHRpdGxlID0gIkxMRSAxIgopCgpheHkgPC0gbGlzdCgKICB0aXRsZSA9ICJMTEUgMiIKKQoKYXh6IDwtIGxpc3QoCiAgdGl0bGUgPSAiTExFIDMiCikKCnQgPC0gbGlzdCgKICBzaXplID0gMTYsCiAgY29sb3IgPSAiYmxhY2siKQoKZmlnIDwtIHBsb3RfbHkobGxlX2RmLCB4ID0gflgxLCB5ID0gflgyLCB6ID0gflgzLCBjb2xvciA9IH5pZGVudF8yLCBtYXJrZXIgPSBsaXN0KHNpemUgPSA2KSwgc3ltYm9sID0gfmFjdGl2ZSwgc3ltYm9scyA9IGMoImRpYW1vbmQiLCAiY2lyY2xlIikgKQpmaWcgPC0gZmlnICU+JSBhZGRfbWFya2Vycyhjb2xvcnMgPSBjKCdibHVlJywgJ3JlZCcsICdwdXJwbGUnLCAnbGlnaHRncmVlbicpKQpmaWcgPC0gZmlnICU+JSBsYXlvdXQoc2NlbmUgPSBsaXN0KGFzcGVjdG1vZGUgPSAiY3ViZSIsIHhheGlzPWF4eCx5YXhpcz1heHksemF4aXM9YXh6KSwgZm9udCA9IHQpCmZpZwpgYGAKCgoKCgo=